home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d5 / pmusic12.arc / PLAYPOLY.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-29  |  2KB  |  74 lines
  1. program playply;
  2.  
  3. {$L ppoly_s}
  4.  
  5. {uses polyfunc;}
  6.  
  7. const
  8.           DEFTEMP = 1024;
  9.           FILENAMEEXT = '.ply';
  10.  
  11. var
  12.     tempval, badchar : integer;
  13.     infile : file;
  14.  
  15. procedure poly(s,o:word); external;
  16.  
  17. procedure playpoly(filename:string; defaulttempo:word);
  18. var
  19.     tune : pointer;
  20.     fsize : longint;
  21.     p : ^word;
  22.     infilename : string;
  23.  
  24. begin
  25.     infilename := filename;
  26.     if pos('.', filename) = 0 then
  27.         infilename := infilename+FILENAMEEXT;
  28.     assign(infile, infilename);
  29.     reset(infile,1);
  30.     fsize := filesize(infile);
  31.     getmem( p, word(fsize)+1 );
  32.     p^ := defaulttempo;
  33.     tune := p;
  34.     p := ptr(seg(p^),ofs(p^)+2);
  35.     blockread(infile,p^,word(fsize));
  36.     close(infile);
  37.     poly(seg(tune^),ofs(tune^));
  38.     freemem(tune,word(fsize));
  39. end;
  40.  
  41.  
  42. procedure message;
  43. begin
  44.     writeln('Usage: PlayPoly <plyfile> [tval]');
  45.     writeln;
  46.     writeln('where:');
  47.     writeln('   <plyfile> = the name of the file to play.');
  48.     writeln('   [tval]    = [optional] starting tempo value, 1 (fast) - 65535 (slow)');
  49.     writeln;
  50.     writeln('PlayPoly.EXE and its original source code is Copyright (c) 1989 - ');
  51.     writeln('GrigaSoft Productions. PlayPoly may not be included in any commercial');
  52.     writeln('software package without explicit written permission from the author.');
  53.     writeln('This package is an unregistered evaluation copy for demo use only.');
  54.     writeln('Register your copy today!');
  55. end;
  56.  
  57. begin
  58.     if paramcount > 0 then begin
  59.         if paramcount > 1 then begin
  60.             val(paramstr(2),tempval,badchar);
  61.             if badchar = 0 then
  62.                 playpoly( paramstr(1), tempval )
  63.             else begin
  64.                 message;
  65.                 halt(2);
  66.             end;
  67.         end else
  68.             playpoly(paramstr(1),DEFTEMP);
  69.     end else begin
  70.         message;
  71.         halt(1);
  72.     end;
  73. end.
  74.